home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 54
/
054.d81
/
pivot point
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
6KB
|
190 lines
0 poke53248+21,.
5 gosub 20000
10 print"[147]":deffna(x)=(16-(peek(56320)and16))or(16-(peek(56321)and16))
15 clr:dimbo(8,8):s=54272:fori=0to23:pokei+s,0:next:pokes+24,15
20 pokes+6,248:pokes+1,33:pokes+13,248:pokes+8,20:pokes+20,248:pokes+15,8
25 deffnb(x)=(16-(peek(56320)and16))or(16-(peek(56321)and16))
27 sz$=" "
30 print"[147]":poke53280,11:poke53281,12
35 d$=" [157][157] [145][146]":c$="[144]"
40 z=1:fory=1to8:printtab(7):forx=1to8
45 printmid$(c$,z,1)d$;:z=3-z:next:print"":z=3-z:next
50 print"[144]";
55 fori=1to24:printtab(30)"[170]":next:printtab(30)"[170]"
60 print"[175][175][175][175][175][175][175]"tab(23)"[175][175][175][175][175][175][175][186]"
65 print"[183][183][183][183][183][183][183]"tab(23)"[183][183][183][183][183][183][183][208]"
70 print""tab(33)"tilt"
75 c$="[158][158]":forx=1to5:fory=1to3:printtab(34)mid$(c$,x,1)" [146]"
80 ifx=3andy=2then90
85 nexty
90 nextx
95 fori=16320to16383:pokei,0:next:fory=0to1:forx=0to1:poke16320+y*3+x,255
100 next:next
105 poke53248,40:poke53249,145:poke2040,255:poke53264,1:poke53287,1
110 poke53271,0:poke53277,0:poke53286,0:poke53269,1
115 fory=1to2:forx=3-yto8step2:bo(x,y)=1:next:next
120 fory=1to2:forx=3-yto8step2:bo(x,y+6)=-1:next:next
125 gosub385
130 fori=16256to16319:pokei,0:next
135 forx=0to1:fory=0to1:poke16256+y*3+x,255
138 poke16256+x+(y+14)*3,255:next:next
140 fory=2to13:poke16256+y*3,192:poke16257+y*3,3:next
145 poke2041,254:poke53250,80:poke53251,82:poke53288,1:poke53269,3
150 tu=1:x3=1:y3=1:ph$(1)="blue "
155 ju=0:x=x3:y=y3:ph$(2)="green"
160 gosub375:print"[144] "ph$(tu)" player is up "
165 print" place cursor on piece to move "
166 print" press space to select piece "
168 poke214,22:print:print" press q to quit to loadstar"
170 gosub425:z=1:iftu=2thenz=-1
175 ifsgn(bo(x,y))<>zthengosub825:goto170
180 gosub815
185 x1=x:y1=y:print" place on square to move to "
190 gosub425:ifbo(x,y)<>0thengosub825:goto190
195 x3=x:y3=y
200 ifx1=xory1=ythengosub825:goto160
205 ifabs(x1-x)<>abs(y1-y)thengosub825:goto160
210 z=1:iftu=zthenz=-z
215 ifsgn(y-y1)=zandabs(bo(x1,y1))=1thengosub825:goto160
220 ifabs(x1-x)=1then245
225 ifabs(x1-x)>2thengosub825:goto160
230 x2=int(x1+x)/2:y2=int(y1+y)/2
235 ifsgn(bo(x2,y2))<>zthengosub825:goto160
240 ju=1
245 gosub820:bo(x,y)=bo(x1,y1):bo(x1,y1)=0:ifabs(x1-x)=2thenbo(x2,y2)=0
250 forx=1to8
255 ifbo(x,1)=-1thenbo(x,1)=-2
260 ifbo(x,8)=1thenbo(x,8)=2
265 next
270 gosub375
275 gosub385:gosub360
280 ifju=1thengosub465:goto280
285 tu=tu+1:iftu>2thentu=1
290 gosub590
295 goto155
360 s1=0:s2=0:fory=1to4:forx=1to8
365 s1=s1+abs(bo(x,y))*(5-y):s2=s2+abs(bo(x,y+4))*y:next:next
370 poke53249,145-(s1-s2)*3:return
375 print""sz$:printsz$:printsz$:return
385 c$="[144][154][153]":print"":fory=1to8:printtab(7):forx=1to8
390 if(x+y)/2=int((x+y)/2)thenprint"";:goto415
395 z=2:ifbo(x,y)<0thenz=4
400 ifabs(bo(x,y))=2thenz=z+1
405 ifbo(x,y)=0thenz=1
410 printmid$(c$,z,1)d$;
415 next:print"":next
420 return
425 j=31-(peek(56322-tu)and31):getga$
430 ifga$="[145]"or (jand1)=1theny=y-1:ify<1theny=8
435 ifga$=""or (jand2)=2theny=y+1:ify>8theny=1
440 ifga$="[157]"or (jand4)=4thenx=x-1:ifx<1thenx=8
445 ifga$=""or (jand8)=8thenx=x+1:ifx>8thenx=1
446 if ga$="q" then 30000
450 poke53250,x*16+64:poke53251,y*16+66
455 ifga$=" "orj=16thenreturn
460 goto 425
465 z=1:iftu=2thenz=-z
470 a=-1:b=1:ifbo(x3,y3)=1thena=0
475 ifbo(x3,y3)=-1thenb=0
480 forx4=-1to1:fory4=atob
485 ifx4=0ory4=0then515
490 x5=x3+x4:y5=y3+y4:ifx5<1orx5>8ory5<1ory5>8then515
495 ifsgn(bo(x5,y5))<>-zthen515
500 x5=x3+x4*2:y5=y3+y4*2:ifx5<1orx5>8ory5<1ory5>8then515
505 ifbo(x5,y5)<>0then515
510 ju=2
515 next:next:ju=ju-1
520 ifju=0thenreturn
525 print"[144] jump again! ":gosub815
530 x=x3:y=y3:gosub425
535 ifabs(x-x3)<>2orabs(y-y3)<>2thengosub825:goto530
540 ifbo(x,y)<>0thengosub825:goto530
545 x2=(x+x3)/2:y2=(y+y3)/2
550 ifsgn(bo(x2,y2))<>-zthengosub825:goto530
555 ifsgn(y3-y)=zandabs(bo(x3,y3))=1thengosub825:goto530
560 gosub820:gosub375
565 bo(x2,y2)=0:bo(x,y)=bo(x3,y3):bo(x3,y3)=0:x3=x:y3=y:forx=1to8
570 ifbo(x,1)=-1thenbo(x,1)=-2
575 ifbo(x,8)=1thenbo(x,8)=2
580 next
585 gosub360:goto385
590 a=peek(53249)-145:ifabs(a)<33then600
595 a=peek(53249)-145:ifabs(a)>7thengosub605:gosub660:goto595
600 goto660
605 a=1:z=1:c=0:ifs1<s2thena=a+z:z=-z:c=4
610 print"[144] "ph$(a)", you need to remove":gosub825
615 print" pieces until balanced "
620 d=0:fory=1+cto4+c:forx=1to8:ifsgn(bo(x,y))<>zthennext:next:goto650
625 q=tu:tu=a
630 gosub425:ifsgn(bo(x,y))<>zthengosub825:goto630
635 ify<1+cory>4+cthengosub825:goto630
640 tu=q
645 bo(x,y)=0:x3=x:y3=y:gosub820:gosub375:gosub360:goto385
650 p1=1:p2=0:ifa=1thenp2=1:p1=0
655 goto675
660 p1=0:p2=0:fory=1to8:forx=1to8:ifbo(x,y)<0thenp2=p2+1
665 ifbo(x,y)>0thenp1=p1+1
670 next:next
675 ifp1=0thengosub375:print"[144] green wins!!! "
680 ifp2=0thengosub375:print"[144] blue wins!!! "
685 ifp1=0orp2=0then760
690 p1=1:p2=1:z=1:iftu<>zthenz=-z
695 forx=1to8:fory=1to8:ifsgn(bo(x,y))<>zthen745
700 a=-1:b=1:ifbo(x,y)=1thena=0
705 ifbo(x,y)=-1thenb=0
710 forx4=-1to1:fory4=atob:x1=x+x4:y1=y+y4
715 ifx1=xory1=yorx1<1orx1>8ory1<1ory1>8then740
720 ifbo(x1,y1)=0then755
725 ifsgn(bo(x1,y1))=zthen740
730 x2=x4*2+x:y2=y4*2+y:ifx2<1orx2>8ory2<1ory2>8then740
735 ifbo(x2,y2)=0then755
740 next:next
745 next:next:p1=0:iftu=2thenp1=1:p2=0
750 goto675
755 return
760 poke198,0
765 z=5:dz=-2:pokes+4,33
770 pokes+1,z:z=z+dz:q=-2:ifdz=qthenq=6
775 dz=q:ifz<100then770
780 pokes+4,32
785 iffnb(1)=16then785
790 poke53248+21,0:print" play again? (y/n)"
795 geta$:ifa$="" then 795
800 ifa$="y"ora$="[217]"orfnb(1)=16 then 15
805 ifa$="n"ora$="[206]"then 1000
810 goto 795
815 pokes+4,33:fork=1to50:next:pokes+4,32:return
820 pokes+11,33:fork=1to50:next:pokes+11,32:return
825 pokes+18,33:fork=1to50:next:pokes+18,32:return
1000 open15,8,15,"r0:hello connect=hello connect":input#15,er,er$:close15
1001 ifer<>63 then print"[147]":end
1002 load"hello connect",8,1
20000 poke53265,peek(53265)and239:poke53280, 6:poke53281, 1:print"[147][142]";
20001 print"[155] [146][156]O[183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]P[155] [146][156][165]loadstarpr";
20002 print"esents[156][167][152] [155] [146][156]L[175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][186][152] [155] ";
20003 print" [152] [155] [150] ";
20004 print"[155] [150] [144] [144] [144][160] [150] [152] [155] [150][160] [144]";
20005 print" [144] [144] [160][150] [152] [155] [150] [146][159]O[183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]";
20006 print"[183][183]P [150] [152] [155] [150] [144] [146][159][180][167] [150] [152] [155] [160] ";
20007 print"[150] [144] [146][159][180][156]pivotpoint[159][167] [150] [152] [155] [150] [144] [146][159][180]";
20008 print"[167] [150] [152] [155] [150] [146][159][180][167] [150] [152] [155] ";
20009 print" [150] [146][159][180][149]byjohnfedor[159][167] [150] [152] [155] [150] [146][159][180]";
20010 print"[167] [150] [152] [155] [150] [144] [146][159]L[175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][175][186][144] [150] [152] [155]";
20011 print" [160] [150] [144] [144] [144] [144] [144] [150] [152] [155] [150] [144] ";
20012 print" [144] [144] [144] [144] [150] [152] [155] [150] [146][156]O[183][183][183][183][183][183][183][183][183][183][183][183][183][183][183]P";
20013 print" [150] [152] [155] [150] [146][156][180]copyright1988[156][167] [150] [152] [155] ";
20014 print" [15